home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PC World Interactive 7
/
PC World Interactive 7.iso
/
program
/
pasprog.EXE
/
TURKDOS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1980-01-10
|
28KB
|
1,216 lines
{ --- YAKUP ERSÿN GENÇTÜRK TURKDOS SÜRÜM 2.0 (C) 93-94-95 --- }
{$M 8192,0,0}
{$I-}
USES CRT,DOS,STRINGS;
LABEL DONGU,ATLAMA;
TYPE
TCMOS = ARRAY[0..$63] OF BYTE;
RESIMBUF = ARRAY[0..64000] OF BYTE;
REGTIP = RECORD AX,BX,CX,DX,BP,SI,DDI,DS,ES,FLAGS:INTEGER;
END;
CONST
HANGIGUN:ARRAY[0..6] OF STRING[9] = ('Pazar','Pazartesi','Salì','Çarƒamba','Perƒembe','Cuma','Cumartesi');
BR:ARRAY[BOOLEAN] OF STRING[3]=('ON','OFF');
VAR
NUM, INFO, J: BYTE;
I: LONGINT;
CMOS: TCMOS;
F: FILE OF TCMOS;
R:REGTIP;
BK:BOOLEAN;
S2:CHAR;
HAFIZAZ:WORD;
ESKISI,ESKISI2:PROCEDURE;
SAYACI,KORUMA:INTEGER;
XXX,YYY:INTEGER;
SAKLA: ARRAY [1..4000] OF CHAR;
RENKNEYDI,PP,A:INTEGER;
ESKIINT:PROCEDURE;
ENVSAYISI:INTEGER;
KOMBUF:STRING;
HATA:INTEGER;
DIZIN:STRING;
CEVAP:STRING[1];
KOMUT:STRING;
SAAT1,DAKIKA,SANIYE,SALISE:WORD;
AY,YIL,GUN,X:WORD;
TIP:STRING;
XAC,YAC:INTEGER;
REGS:REGISTERS;
FUNCTION SURUCUBUL:CHAR;ASSEMBLER;
ASM
MOV AH,19H
INT 21H
ADD AL,'A'
END;
PROCEDURE SIL;
BEGIN
CLRSCR;
WRITELN;
HATA:=1;
END;
PROCEDURE KARTNE; {EKRAN KARTININ NE OLDUGUNU ANLAMAK ICIN}
BEGIN
IF MEM[$B800:0]=$20 THEN TIP:='Renkli';
IF MEM[$B000:0]=$20 THEN TIP:='Monokrom';
END;
PROCEDURE TARIHNE;
BEGIN
GETDATE(YIL,AY,GUN,X);
END;
PROCEDURE SAATKAC; {SAAT ICIN PROSEDURU}
BEGIN
GETTIME(SAAT1,DAKIKA,SANIYE,SALISE);
END;
PROCEDURE SIYAHZ; {SIYAH ZEMIN ICIN TANIM}
BEGIN
TEXTBACKGROUND(BLACK);
END;
PROCEDURE BEYAZZ; {BEYAZ ZEMIN ICIN TANIM}
BEGIN
TEXTBACKGROUND(WHITE);
END;
PROCEDURE SARI; {SARI RENK ICIN TANIM}
BEGIN
TEXTCOLOR(YELLOW);
END;
PROCEDURE SIYAH; {SIYAH RENK ICIN TANIM}
BEGIN
TEXTCOLOR(BLACK);
END;
PROCEDURE KIRMIZI; {KIRMIZI RENK ICIN TANIM}
BEGIN
TEXTCOLOR(RED);
END;
PROCEDURE MAVI; {MAVI RENK ICIN TANIM}
BEGIN
TEXTCOLOR(BLUE);
END;
PROCEDURE YESIL; {YESIL RENK ICIN TANIM}
BEGIN
TEXTCOLOR(GREEN);
END;
PROCEDURE BEYAZ; {BEYAZ RENK ICIN TANIM}
BEGIN
TEXTCOLOR(WHITE);
END;
PROCEDURE HATA_KONTROL;
BEGIN
IF KOMUT='' THEN EXIT;
IF HATA<>1 THEN BEGIN
YESIL;
SOUND(100);DELAY(70);NOSOUND;
WRITELN('Yanlìƒ komut.');
SARI;
END;
IF HATA=1 THEN HATA:=0
END;
PROCEDURE HAFIZAZZ;
BEGIN
REGS.AH:=$88;
INTR($15,REGS);
HAFIZAZ:=REGS.AX;
END;
PROCEDURE SISTEM_NE; {BILGISAYARIN OZELLIKLERI HAKKINDA PROSEDUR}
BEGIN
SAATKAC;
TARIHNE;
HAFIZAZZ;
SIYAHZ;
BEYAZ;
WRITELN('Sistem Bilgisi :');
WRITELN;
IF TIP='' THEN TIP:='Bilinmiyor';
KIRMIZI;WRITE('Kullanìlabilir bellek miktarì : ');SARI;WRITELN(memavail,' byte.');
KIRMIZI;WRITE('En büyük serbest blok : ');SARI;WRITELN(MAXAVAIL,' byte.');
KIRMIZI;WRITE('Üst hafìza miktarì : ');SARI;WRITELN(HAFIZAZ,' kbyte.');
KIRMIZI;WRITE('Ms-Dos versiyonu : ');SARI;WRITELN(LO(DOSVERSION),'.',HI(DOSVERSION));
KIRMIZI;WRITE('Kullanìmda olan diskteki boƒ yer : ');SARI;WRITELN(DISKFREE(0),' bayt.');
KIRMIZI;WRITE('Kullanìmda olan diskin kapasitesi : ');SARI;WRITELN(DISKSIZE(0),' bayt.');
KIRMIZI;WRITE('₧u anda saat : ');SARI;WRITELN(SAAT1,':',DAKIKA,':',SANIYE);
KIRMIZI;WRITE('₧u anda tarih : ');SARI;WRITELN(GUN,'/',AY,'/',YIL,'-',HANGIGUN[X]);
KIRMIZI;WRITE('Ekran kartì : ');SARI;WRITELN(TIP);
KIRMIZI;WRITE('Çalìƒìlan programìn adì : ');SARI;WRITELN(PARAMSTR(0));
WRITELN;
HATA:=1;
END;
PROCEDURE SISTEM_NE2; {BILGISAYARIN AYRINTILI OZELLIKLERI HAKKINDA PROSEDUR 2 }
VAR
MAKINATIPI,SURUCU_SAYILARI,ADRES,ADRESS,PRINTER,SERIPORT,MATEMATIK:INTEGER;
MTIP,VARMIDIR:STRING;
BEGIN
MAKINATIPI:=MEM[$F000:$FFFE];
CASE MAKINATIPI OF
$FF:MTIP:=('PC ');
$FE:MTIP:=('XT Veya taēnabilir');
$FD:MTIP:=('PC Junior ');
$FC:MTIP:=('AT ');
$FB:MTIP:=('XT ');
END;
ADRES:=MEMW[0:1040];
ADRESS:=(ADRES DIV 2);
PRINTER:=(ADRESS AND 24576) DIV 8192;
SERIPORT:=(ADRES AND 3584) DIV 512;
MATEMATIK:=(ADRES AND 2);
CASE MATEMATIK OF
0:VARMIDIR:= ('Yok');
1:VARMIDIR:= ('Var');
END;
SURUCU_SAYILARI:=(ADRES AND 192) DIV 64 +1;
SAATKAC;
TARIHNE;
GETDIR(0,DIZIN);
HAFIZAZZ;
SIYAHZ;
BEYAZ;
WRITELN('Sistem Bilgisi :');
WRITELN;
IF TIP='' THEN TIP:='Bilinmiyor';
KIRMIZI;WRITE('Kullanìlabilir bellek miktarì : ');SARI;WRITELN(memavail,' byte.');
KIRMIZI;WRITE('En büyük serbest blok : ');SARI;WRITELN(MAXAVAIL,' byte.');
KIRMIZI;WRITE('Üst hafìza miktarì : ');SARI;WRITELN(HAFIZAZ,' kbyte.');
KIRMIZI;WRITE('Ms-Dos versiyonu : ');SARI;WRITELN(LO(DOSVERSION),'.',HI(DOSVERSION));
KIRMIZI;WRITE('Kullanìmda olan diskteki boƒ yer : ');SARI;WRITELN(DISKFREE(0),' bayt.');
KIRMIZI;WRITE('Kullanìmda olan diskin kapasitesi : ');SARI;WRITELN(DISKSIZE(0),' bayt.');
KIRMIZI;WRITE('₧u anda saat : ');SARI;WRITELN(SAAT1,':',DAKIKA,':',SANIYE);
KIRMIZI;WRITE('₧u anda tarih : ');SARI;WRITELN(GUN,'/',AY,'/',YIL,'-',HANGIGUN[X]);
KIRMIZI;WRITE('Ekran kartì : ');SARI;WRITELN(TIP);
KIRMIZI;WRITE('Çalìƒìlan programìn adì : ');SARI;WRITELN(PARAMSTR(0));
KIRMIZI;WRITE('Printer portu sayìsì : ');SARI;WRITELN(PRINTER,' adet.');
KIRMIZI;WRITE('Seri port sayìsì : ');SARI;WRITELN(SERIPORT,' adet.');
KIRMIZI;WRITE('Matematik iƒlemci : ');SARI;WRITELN(VARMIDIR);
KIRMIZI;WRITE('Sürücü sayìsì : ');SARI;WRITELN(SURUCU_SAYILARI,' adet.');
KIRMIZI;WRITE('Makina tipi : ');SARI;WRITELN(MTIP,' tipinde.');
KIRMIZI;WRITE('₧u anda çalìƒtìºìnìz dizin : ');SARI;WRITELN(DIZIN);
WRITELN;
HATA:=1;
END;
PROCEDURE HAFIZA;
BEGIN
BEYAZ;
KIRMIZI;WRITE('Kullanìlabilir bellek miktarì : ');SARI;WRITELN(memavail,' byte.');
KIRMIZI;WRITE('En büyük serbest blok : ');SARI;WRITELN(MAXAVAIL,' byte.');
HATA:=1;
END;
PROCEDURE ENV;
BEGIN
HIGHVIDEO;
MAVI;
FOR ENVSAYISI := 1 TO ENVCOUNT DO
WRITELN(ENVSTR(ENVSAYISI));
LOWVIDEO;
SARI;
HATA:=1;
END;
FUNCTION TUS:INTEGER;
BEGIN
REGS.AH:=$02;
INTR($16,REGS);
TUS:=REGS.AL;
END;
PROCEDURE SAAT;{USTTE DURAN SAAT ICIN PROSEDUR.}
BEGIN
XAC:=WHEREX;YAC:=WHEREY; {KURSOR POZISYONUNU SAKLA}
GETTIME(SAAT1,DAKIKA,SANIYE,SALISE);
SIYAH;
BEYAZZ;
WINDOW(1,1,80,25);
GOTOXY(1,1);
KIRMIZI;
WRITE('[TÜRK-DOS] ');SIYAH;WRITELN(' ');
MAVI;
IF TUS= 176 THEN
BEGIN
SIYAH;
GOTOXY(18,1);
WRITE('NUM ')
END;
IF TUS= 160 THEN
BEGIN
SIYAH;
GOTOXY(14,1);
WRITE('NUM ');
END;
IF TUS= 192 THEN
BEGIN
SIYAH;
GOTOXY(18,1);
WRITE('CAP ')
END;
IF TUS= 208 THEN
BEGIN
SIYAH;
GOTOXY(18,1);
WRITE('CAP ')
END;
IF TUS= 224 THEN
BEGIN
SIYAH;
GOTOXY(14,1);
WRITE('NUM-CAP');
END;
IF TUS= 240 THEN
BEGIN
SIYAH;
GOTOXY(14,1);
WRITE('NUM-CAP');
END;
GOTOXY(22,1);
MAVI;
WRITE('DÿSK: ');KIRMIZI;WRITE(DISKFREE(0):9);MAVI;WRITE(' byte.');
WRITE(' HAFIZA: ');KIRMIZI;WRITE(MEMAVAIL:7);MAVI;WRITE(' byte.');WRITE(' SAAT: ');KIRMIZI;
WRITE(SAAT1,':',DAKIKA,':',SANIYE);
WINDOW(1,2,80,25);
SIYAHZ;
SARI;
GOTOXY(XAC,YAC);
END;
PROCEDURE ETI;
VAR
ETIKET:SEARCHREC;
BEGIN
FINDFIRST('*.*',VOLUMEID,ETIKET);
WHILE POS(' ',ETIKET.NAME) > 0 do
ETIKET.NAME[POS(' ', ETIKET.NAME)] := '0';
IF DOSERROR = 0 THEN
BEGIN
MAVI;WRITE('Etiket ÿsmi: ');KIRMIZI;WRITELN(ETIKET.NAME);
END;
HATA:=1;
END;
PROCEDURE DIR;
VAR
SAYACAB:INTEGER;
DOSYA:SEARCHREC;
NOKTA:INTEGER;
ISIM,UZAN:STRING;
ZAMAN:LONGINT;
ZAMAN2:DATETIME;
BEKLEME:STRING;
BEGIN
SAYACAB:=0;
ETI; {ETIKET PROSEDURUNU ÇALI₧TIR}
GETDIR(0,DIZIN);
MAVI;WRITE('₧u Anki sürücü ve dizin : ');KIRMIZI;WRITELN(DIZIN);
BEYAZ;
FINDFIRST('*.*',DIRECTORY+READONLY+HIDDEN+SYSFILE+ARCHIVE ,DOSYA);
WHILE DOSERROR = 0 DO BEGIN
GETFTIME(DOSYA,ZAMAN);
UNPACKTIME(ZAMAN,ZAMAN2);
NOKTA := POS('.', DOSYA.NAME);
IF NOKTA>1 THEN BEGIN
ISIM := COPY(DOSYA.NAME, 1, NOKTA - 1);
UZAN := COPY(DOSYA.NAME, NOKTA + 1, 3);
END ELSE BEGIN
ISIM := DOSYA.NAME;
UZAN := '';
END;
IF DOSYA.ATTR=8 THEN FINDNEXT(DOSYA);
IF DOSYA.ATTR=16 THEN BEGIN
WRITE(ISIM,' ':9 - LENGTH(ISIM));YESIL;
WRITELN(UZAN,' ':4 - LENGTH(UZAN),' <DIZIN> ',' ',ZAMAN2.DAY,'/',ZAMAN2.MONTH,'/',ZAMAN2.YEAR);BEYAZ;
END;
IF DOSYA.ATTR<>16 THEN BEGIN
WRITE(ISIM,' ':9 - LENGTH(ISIM));YESIL;
WRITELN(UZAN,' ':4 - LENGTH(UZAN),' ',DOSYA.SIZE:10,' ',ZAMAN2.DAY,'/',ZAMAN2.MONTH,'/',ZAMAN2.YEAR);BEYAZ;
END;
SAYACAB:=SAYACAB+1;
IF SAYACAB=20 THEN BEGIN
WRITELN('--- DEVAM ---');
BEKLEME:=READKEY;
SAYACAB:=0;
END;
FINDNEXT(DOSYA);
END;
KIRMIZI;WRITE('Kullanìmda olan diskteki boƒ yer : ');SARI;
WRITELN(DISKFREE(0),' bayt.'); {DISKETTEKI BOS YERI VE KAPASITEYI BILDIR.}
KIRMIZI;WRITE('Kullanìmda olan diskin kapasitesi : ');SARI;WRITELN(DISKSIZE(0),' bayt.');
HATA:=1;
TEXTCOLOR(YELLOW);
END;
PROCEDURE DIR2;
VAR
SAYACAB:INTEGER;
DOSYA:SEARCHREC;
NOKTA:INTEGER;
ISIM,UZAN:STRING;
ZAMAN:LONGINT;
ZAMAN2:DATETIME;
BEKLEME:STRING;
BEGIN
SAYACAB:=0;
ETI; {ETIKET PROSEDURUNU ÇALI₧TIR}
GETDIR(0,DIZIN);
MAVI;WRITE('₧u Anki sürücü ve dizin : ');KIRMIZI;WRITELN(DIZIN);
BEYAZ;
FINDFIRST('*.*',DIRECTORY+READONLY+HIDDEN+SYSFILE+ARCHIVE ,DOSYA);
WHILE DOSERROR = 0 DO BEGIN
IF DOSYA.ATTR=8 THEN FINDNEXT(DOSYA);
IF DOSYA.ATTR=16 THEN BEGIN
WRITE('[',DOSYA.NAME:8,']',' ');BEYAZ;
END;
IF DOSYA.ATTR<>16 THEN BEGIN
YESIL;WRITE(' ',DOSYA.NAME:8,' ',' ');BEYAZ;
END;
FINDNEXT(DOSYA);
END;
WRITELN;
KIRMIZI;WRITE('Kullanìmda olan diskteki boƒ yer : ');SARI;
WRITELN(DISKFREE(0),' bayt.'); {DISKETTEKI BOS YERI VE KAPASITEYI BILDIR.}
KIRMIZI;WRITE('Kullanìmda olan diskin kapasitesi : ');SARI;WRITELN(DISKSIZE(0),' bayt.');
HATA:=1;
TEXTCOLOR(YELLOW);
END;
PROCEDURE DIR3;
VAR
DOSYA:SEARCHREC;
NOKTA:INTEGER;
ISIM,UZAN:STRING;
ZAMAN:LONGINT;
ZAMAN2:DATETIME;
BEGIN
HATA:=1;
ETI; {ETIKET PROSEDURUNU ÇALI₧TIR}
GETDIR(0,DIZIN);
MAVI;WRITE('₧u Anki sürücü ve dizin : ');KIRMIZI;WRITELN(DIZIN);
BEYAZ;
FINDFIRST('*.*',DIRECTORY+READONLY+HIDDEN+SYSFILE+ARCHIVE ,DOSYA);
WHILE DOSERROR = 0 DO BEGIN
GETFTIME(DOSYA,ZAMAN);
UNPACKTIME(ZAMAN,ZAMAN2);
NOKTA := POS('.', DOSYA.NAME);
IF NOKTA>1 THEN BEGIN
ISIM := COPY(DOSYA.NAME, 1, NOKTA - 1);
UZAN := COPY(DOSYA.NAME, NOKTA + 1, 3);
END ELSE BEGIN
ISIM := DOSYA.NAME;
UZAN := '';
END;
IF DOSYA.ATTR=8 THEN FINDNEXT(DOSYA);
WITH ZAMAN2 DO BEGIN
IF DOSYA.ATTR=16 THEN BEGIN
WRITE(ISIM,' ':9 - LENGTH(ISIM));YESIL;
WRITELN(UZAN,' ':4 - LENGTH(UZAN),' <DIZIN> ',' ',DAY,'/',MONTH,'/',YEAR);BEYAZ;
END;
IF DOSYA.ATTR<>16 THEN BEGIN
WRITE(ISIM,' ':9 - LENGTH(ISIM));YESIL;
WRITELN(UZAN,' ':4 - LENGTH(UZAN),' ',DOSYA.SIZE:10,' ',DAY,'/',MONTH,'/',YEAR);BEYAZ;
END;
END;
FINDNEXT(DOSYA);
END;
KIRMIZI;WRITE('Kullanìmda olan diskteki boƒ yer : ');SARI;
WRITELN(DISKFREE(0),' bayt.'); {DISKETTEKI BOS YERI VE KAPASITEYI BILDIR.}
KIRMIZI;WRITE('Kullanìmda olan diskin kapasitesi : ');SARI;WRITELN(DISKSIZE(0),' bayt.');
TEXTCOLOR(YELLOW);
END;
PROCEDURE VERSION;
BEGIN
HATA:=1;
TEXTCOLOR(130);
WRITE('TÜRK-DOS ');BEYAZ;WRITELN('V2.0 (C) 1993-94-95 Yakup Ersin Gençtürk ');
WRITELN('Bütün haklarì saklìdìr. (C) YEG');
SARI;
END;
PROCEDURE ASC;
VAR
K:CHAR;
BEGIN
HATA:=1;
A:=0;
BEYAZ;
FOR K:=#33 TO #254 DO BEGIN
A:=A+1;
IF K<#100 THEN BEGIN
WRITE('KARAKTER NO:');YESIL;WRITE(ORD(K):2);BEYAZ;WRITE(' KARAKTER KARSILIGI:');YESIL;WRITE(K:3,' ');BEYAZ;
END ELSE BEGIN
WRITE('KARAKTER NO:');YESIL;WRITE(ORD(K):2);BEYAZ;WRITE(' KARAKTER KARSILIGI:');YESIL;WRITE(K:3,' ');BEYAZ;
END;
IF A>43 THEN BEGIN
WRITELN('--- DEVAM ---');
READLN;
A:=0;
END;
END;
SARI;
END;
PROCEDURE DIZIND;
VAR
DIZINAL:STRING;
BEGIN
{$I-}
HATA:=1;
YESIL;
WRITE('Hangi dizine geçmek istiyorsunuz : ');READLN(DIZINAL);
CHDIR(DIZINAL);
IF IORESULT <> 0 THEN WRITELN('Hata : ',DIZINAL,' adìnda dizin bulunamadì. ');
END;
PROCEDURE DIZINY;
VAR
DIZINAL:STRING;
BEGIN
HATA:=1;
YESIL;
WRITE('Oluƒturulacak dizinin adì ne : ');READLN(DIZINAL);
MKDIR(DIZINAL);
IF IORESULT <> 0 THEN WRITELN('Hata : Disket hatasì dizin oluƒmadì. ');
END;
PROCEDURE DIZINS;
VAR
DIZINAL:STRING;
BEGIN
HATA:=1;
YESIL;
WRITE('Hangi dizini silmek istiyorsunuz : ');READLN(DIZINAL);
RMDIR(DIZINAL);
IF IORESULT <> 0 THEN WRITELN('Hata : Dizin boƒ deºil yada ',DIZINAL,' adìnda bir dizin yok. ');
END;
PROCEDURE DOSS;
VAR
KOMUT : STRING[127];
DIZINNEDIR:STRING;
BEGIN
HATA:=1;
REPEAT
BEYAZ;
GETDIR(0,DIZINNEDIR);
WRITE('[TÜRK-DOS] ',DIZINNEDIR,'>>');TEXTCOLOR(LIGHTGRAY);
READLN(KOMUT);
IF KOMUT <> '' THEN
BEGIN
SWAPVECTORS;
EXEC(GETENV('COMSPEC'), '/C ' + KOMUT);
SWAPVECTORS;
IF DOSERROR <> 0 THEN
BEGIN;
YESIL;
WRITELN('Hata : COMMAND.COM Bulunamadì.(Comspec deºiƒkenini kontrol edin.)');
END;
END;
UNTIL KOMUT = '';
END;
PROCEDURE DOSYACA;
VAR
GGG,GGG2:STRING;
ACDOSYA:PATHSTR;
UZANTI,PARAME:STRING;
KOMUTX:STRING;
BEGIN
IF KOMUT<>'' THEN BEGIN
IF HATA<>1 THEN BEGIN
KOMUTX:=KOMUT;
ACDOSYA:=FSEARCH(KOMUTX,GETENV('PATH'));
IF ACDOSYA='' THEN BEGIN
KOMUTX:=KOMUT+'.COM';
ACDOSYA:=FSEARCH(KOMUTX,GETENV('PATH'));
IF ACDOSYA='' THEN BEGIN
KOMUTX:=KOMUT+'.EXE';
ACDOSYA:=FSEARCH(KOMUTX,GETENV('PATH'));
IF ACDOSYA='' THEN BEGIN
KOMUTX:=KOMUT+'.BAT';
ACDOSYA:=FSEARCH(KOMUT,GETENV('PATH'));
IF ACDOSYA='' THEN BEGIN
EXIT;
END;
END;
END;
END;
YESIL;
HATA:=1;
WRITE('Program adì : ',ACDOSYA);WRITE(' çalìƒtìrìlsìnmì(E/h) :');GGG:=READKEY;WRITELN(GGG);
GGG2 := UpCase(GGG[1]);
IF GGG2 = 'H' THEN EXIT;
WRITE('Parametre girin,parametre yoksa ENTER <-┘ :');READLN(PARAME);
TEXTCOLOR(LIGHTGRAY);
SWAPVECTORS;
EXEC(ACDOSYA,PARAME);
SWAPVECTORS;
IF DOSERROR <> 0 THEN
BEGIN;
YESIL;
WRITELN('Hata : ',ACDOSYA,' adìndaki dosyanìn açìlìƒìnda hata oldu.');
END;
KIRMIZI;
WRITELN('Kullandìºìnìz programìn çìkìƒ kodu: ',HI(DOSEXITCODE));
YESIL;
IF HI(DOSEXITCODE) =0 THEN WRITELN ('Programdan normal çìkìldì.');
IF HI(DOSEXITCODE) =1 THEN WRITELN ('Programdan CTRL-C ile çìkìldì.');
IF HI(DOSEXITCODE) =2 THEN WRITELN ('Programdan hata ile çìkìldì.');
IF HI(DOSEXITCODE) =3 THEN WRITELN ('Program hafìzada kalìcì.');
SARI;
END;
WRITELN;
END;
HATA:=1;
END;
PROCEDURE DOSYAT;
VAR
TDOSYA:STRING;
TDOSYA2:FILE;
CEVAP:CHAR;
BEGIN
YESIL;
WRITE('Hangi Dosyayì diskten silmek istiyorsunuz : ');READLN(TDOSYA);
ASSIGN(TDOSYA2,TDOSYA);
RESET(TDOSYA2);
IF IORESULT<>0 THEN BEGIN
WRITELN('Hata : ',TDOSYA,' adìnda bir dosya bulunamadì.');
HATA:=1;
EXIT;
END;
CLOSE(TDOSYA2);
WRITE('Dosya veya Dosyalarì silmek istediºinizden eminmisiniz (e/H) :');CEVAP:=UPCASE(READKEY);
WRITELN;
IF CEVAP='E' THEN BEGIN
ERASE(TDOSYA2);
IF IORESULT<>0 THEN BEGIN
WRITELN('Hata : Disk hatasì.Dosya silinemedi.');
HATA:=1;
END ELSE
WRITELN(TDOSYA,' adìndaki dosya silindi.');
END;
HATA:=1;
SARI;
END;
PROCEDURE ISIMD;
VAR
DDOSYA:FILE;
TDOSYA,TDOSYA2:STRING;
BEGIN
HATA:=1;
YESIL;
WRITE('Hangi Dosyanìn ismini deºiƒtirmek istiyorsunuz : ');SARI;READLN(TDOSYA);
ASSIGN(DDOSYA,TDOSYA);
IF IORESULT<>0 THEN BEGIN
WRITELN('Hata : ',TDOSYA,' adìnda bir dosya bulunamadì.');
EXIT;
HATA:=1;
END;
YESIL;
WRITE('Yeni isminin ne olmasìnì istiyorsunuz : ');SARI;READLN(TDOSYA2);
WRITELN(TDOSYA,' ----» ',TDOSYA2);
RENAME(DDOSYA,TDOSYA2);
IF IORESULT<>0 THEN BEGIN
WRITELN('Hata : Disk hatasì.Dosyanìn ismi deºiƒtirilemedi.');
EXIT;
HATA:=1;
END ELSE WRITELN('Tamam.');
HATA:=1;
END;
PROCEDURE GOS;
VAR
YAZI:TEXT;
K:CHAR;
BEKLEME:STRING;
YAZ:STRING;
BEGIN
XXX:=0;
YESIL;
WRITE('ÿçeriºi gösterilecek dosyanìn adì ne : ');READLN(YAZ);
ASSIGN(YAZI,YAZ);
RESET(YAZI);
IF IORESULT<>0 THEN BEGIN
WRITELN('Hata : ',YAZ,' adìnda bir dosya bulunamadì.');
EXIT;
HATA:=1;
END;
BEYAZ;
WHILE NOT EOF(YAZI) DO
BEGIN
READ(YAZI,K);
WRITE(K);
END;
HATA:=1;
END;
PROCEDURE SAATX;
BEGIN
GETTIME(SAAT1,DAKIKA,SANIYE,SALISE);
YESIL;
WRITE('₧u anda saat : ');MAVI;WRITELN(SAAT1,':',DAKIKA,':',SANIYE);
HATA:=1;
SARI;
END;
PROCEDURE TARIH;
BEGIN
TARIHNE;
YESIL;
WRITE('₧u anda tarih : ');MAVI;WRITELN(GUN,'/',AY,'/',YIL,'-',HANGIGUN[X]);
HATA:=1;
SARI;
END;
PROCEDURE TARIHD;
VAR
GUN,AY,YIL:WORD;
BEGIN
TARIH;
YESIL;
WRITE('Yeni günü giriniz :');READLN(GUN);
WRITE('Yeni ayì giriniz :');READLN(AY);
WRITE('Yeni yìlì giriniz :');READLN(YIL);
SETDATE(YIL,AY,GUN);
END;
PROCEDURE SAATD;
VAR
GUN,AY,YIL:WORD;
BEGIN
SAATX;
YESIL;
WRITE('Yeni saati giriniz :');READLN(SAAT1);
WRITE('Yeni dakikayì giriniz :');READLN(DAKIKA);
WRITE('Yeni saniyeyi giriniz :');READLN(SANIYE);
SETTIME(SAAT1,DAKIKA,SANIYE,SANIYE);
END;
PROCEDURE KOPYALA;
VAR
K:STRING;
KAYNAK,HEDEF:STRING;
BEGIN
YESIL;
WRITE('Hangi dosya(lar) kopyalanacak : ');SARI;READLN(KAYNAK);
YESIL;
WRITE('Nereye kopyalanacak(lar) : ');SARI;READLN(HEDEF) ;
BEYAZ;
WRITELN('Lütfen bekleyin DOS copy komutu çalìƒtìrìlìyor...');
SARI;
K:='COPY '+KAYNAK+' '+HEDEF+' /V';
SWAPVECTORS;
SIYAH;
EXEC(GETENV('COMSPEC'), '/C ' + K);
BEYAZ;
WRITELN('Bir tuƒa basìp devam edin...');
K:=READKEY;
SWAPVECTORS;
IF DOSERROR <> 0 THEN
BEGIN;
YESIL;
WRITELN('Hata : COMMAND.COM Bulunamadì.(Comspec deºiƒkenini kontrol edin.)');
END;
HATA:=1;
END;
PROCEDURE SAYIOYUNU;
VAR
SAYIY:INTEGER;
RAST,S2:INTEGER;
MX:INTEGER;
BEGIN
CLRSCR;
MAVI;
WRITE('oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo');
TEXTCOLOR(RED+128);
BEYAZZ;
MX:=0;
WRITE('SAYI-OYUNU ');MAVI;WRITE('(C) 1995 Yakup Ersin Gençtürk ');TEXTCOLOR(GREEN+128);WRITE('TÜRK-DOS');MAVI;
WRITELN(' ÿçin özel sürüm v1.2 ');
SIYAHZ;
YESIL;
WRITE('Rastgele seçileyen sayì enbüyük kaç olabilir (en fazla 4 rakamlì):');SARI;READLN(RAST);
IF RAST>32767 THEN RAST:=32766;
IF IORESULT<>0 THEN EXIT;
SAYIY:=RANDOM(RAST);
HATA:=1;
YESIL;
REPEAT
YESIL;WRITE('Tahmini sayì : ');SARI;READLN(S2);
IF IORESULT<>0 THEN EXIT;
IF S2>SAYIY THEN WRITELN('Tahmini sayì tutulan sayìdan büyük.');
IF S2<SAYIY THEN WRITELN('Tahmini sayì tutulan sayìdan küçük.');
MX:=MX+1;
UNTIL S2=SAYIY;
KIRMIZI;
WRITELN('TEBRÿKLER Gizli sayìyì ',MX,' denemede buldunuz.');
SARI;
END;
PROCEDURE KURSAKLA;
BEGIN
XXX:=WHEREX;YYY:=WHEREY;
END;
PROCEDURE KURKOY;
BEGIN
GOTOXY(XXX,YYY);
END;
PROCEDURE EKRANSAKLA;
BEGIN
MOVE(MEM[$B800:0],SAKLA,4000);
END;
PROCEDURE YERINEKOY;
BEGIN
MOVE(SAKLA,MEM[$B800:0],4000);
END;
PROCEDURE CIK; {CIKIS PROCEDURU ICIN YARDIMCI PROCEDURE}
BEGIN;
SETINTVEC(8,@ESKISI);
SETINTVEC(9,@ESKISI2);
KURKOY;
YERINEKOY;
WRITE('TÜRK-DOS ');KIRMIZI;WRITELN('V2.0 Kullandìºìnìz için teƒekkürler.');
TEXTCOLOR(LIGHTGRAY);
WRITELN(' ');
HALT(0);
END;
PROCEDURE CIKIS;
BEGIN;
TEXTCOLOR(130);
WRITE('TÜRK-DOS ');BEYAZ;WRITELN('V2.0`dan çìkmak istediºinizden eminmisiniz ? ');
WRITE('(e/H) : ');READLN(CEVAP);
IF CEVAP='E' THEN CIK;
IF CEVAP='e' THEN CIK;
IF CEVAP='H' THEN BEGIN;HATA:=1;EXIT ;END;
IF CEVAP='h' THEN BEGIN;HATA:=1;EXIT ;END;
SARI;
HATA:=1;
END;
PROCEDURE EKRANKORU2;
BEGIN
EKRANSAKLA;
KURSAKLA;
WINDOW(1,1,80,25);
SIYAH;SIYAHZ;CLRSCR;
WINDOW(1,2,80,25);
KORUMA:=1;
END;
PROCEDURE EKRANKORU1;INTERRUPT;
BEGIN
SAYACI:=SAYACI+1;
IF SAYACI>1092 THEN EKRANKORU2;
INLINE($9C);
ESKISI;
END;
PROCEDURE EKRANKORU4;
BEGIN
YERINEKOY;
KURKOY;
KORUMA:=0;
END;
PROCEDURE EKRANKORU3;INTERRUPT;
BEGIN
IF KORUMA=1 THEN EKRANKORU4;
SAYACI:=1;
INLINE($9C);
ESKISI2;
END;
FUNCTION SURUCU(S:CHAR):BOOLEAN;ASSEMBLER;
ASM
MOV DL,S
MOV AH,36H
SUB DL,'A'-1
INT 21H
INC AX
JE @@2
MOV AL,1
@@2:
END;
PROCEDURE SURUCUDEG;
VAR
SURUCUK:BYTE;
SUR:CHAR;
BEGIN
YESIL;
S2:=SURUCUBUL;
WRITE('Hangi sürücüye geçmek istiyorsunuz :');SUR:=READKEY;WRITELN(SUR);
SURUCUK:=ORD(SUR)-65;
HATA:=1;
IF ORD(SURUCU(SUR))=0 THEN BEGIN
KIRMIZI;
WRITELN('HATA : Disket bulunamadì.');
SURUCUK:=ORD(S2)-65;
ASM
MOV AH,0EH
MOV DL,SURUCUK
INT 21H
END;
END;
SARI;
ASM
MOV AH,0EH
MOV DL,SURUCUK
INT 21H
END;
END;
PROCEDURE CMOSKAYDET;
VAR
SSSSS:STRING;
BEGIN
NUM := 0;
FOR I := 0 TO $63 DO BEGIN
ASM
XOR AX,AX
MOV AL,NUM
OUT 70H,AL
IN AL,71H
MOV INFO,AL
END;
CMOS[NUM]:=INFO;
INC(NUM);
END;
ASSIGN(F, 'TURKDOS.CMS');
REWRITE(F);
WRITE(F, Cmos);
CLOSE(F);
BEYAZ;
GETDIR(0,SSSSS);
WRITELN('CMOS hafìzasì TURKDOS.CMS adì altìnda ',SSSSS,' dizine kaydedildi.');
WRITELN('Geri yüklemek istediºinizde bu dizine geçip öyle yükleyin.');
END;
PROCEDURE CMOSDOSYASI;
BEGIN
ASSIGN(F, 'TURKDOS.CMS');
RESET(F);
READ(F,CMOS);
CLOSE(F);
IF IORESULT <> 0 then begin
KIRMIZI;
WRITELN('Hata : CMOS`u yüklemek için önce kaydetmeniz lazìm.');
END
ELSE
FOR J := 0 TO $63 DO BEGIN
INFO := CMOS[j];
ASM
XOR AX,AX
MOV AL,J
OUT 70h,AL
MOV AL,INFO
OUT 71h,AL
END;
END;
END;
PROCEDURE CMOSLOAD;
VAR
KLAOKU:STRING;
BEGIN
TEXTCOLOR(WHITE+128);
WRITE('Dikkat');YESIL;WRITELN(' : Bu komut bilgisayarìnìz cmos`unu yüklemenize ve kaydetmenize yarar.');
SARI;
WRITE(' Devam etmek istediºinizden eminmisiniz (e/H) :');
KLAOKU:=UPCASE(READKEY);
IF KLAOKU='E' THEN BEGIN
SARI;
HATA:=1;
WRITELN;WRITELN;WRITELN;
WRITELN('1 - Cmos hafìzasìnì diske kaydet.');
WRITELN('2 - Cmos hafìzasìnì diskten oku .');
WRITELN;
YESIL;
WRITE('Hangi iƒlemi yapmak istiyorsunuz : ');
KLAOKU:=READKEY;
WRITELN;
IF KLAOKU='1' THEN CMOSKAYDET;
IF KLAOKU='2' THEN CMOSDOSYASI;
END
ELSE
EXIT
END;
PROCEDURE HESAPLA;
VAR
ISLEM:STRING;
SAYII1,SAYII2:LONGINT;
BEGIN
HATA:=1;
YESIL;
WRITE('Lütfen hangi iƒlemi yapacaºìnìzì giriniz (+,-,*,/):');ISLEM:=READKEY;
SARI;
IF ISLEM='+' THEN BEGIN
WRITELN(' Toplama');
YESIL;
WRITE('Toplanacak 1.sayìyì giriniz :');SARI;READLN(SAYII1);
YESIL;
WRITE('Toplanacak 2.sayìyì giriniz :');SARI;READLN(SAYII2);
BEYAZ;
WRITE(SAYII1,' ',ISLEM,' ',SAYII2);YESIL;WRITELN(' = ',SAYII1+SAYII2);
END;
IF ISLEM='-' THEN BEGIN
WRITELN(' Çìkarma');
YESIL;
WRITE('Hangi sayìdan çìkaracaksìnìz :');SARI;READLN(SAYII1);
YESIL;
WRITE(SAYII1,' den kaç çìkaracaksìnìz :');SARI;READLN(SAYII2);
BEYAZ;
WRITE(SAYII1,' ',ISLEM,' ',SAYII2);YESIL;WRITELN(' = ',SAYII1-SAYII2);
END;
IF ISLEM='*' THEN BEGIN
WRITELN(' Çarpma ');
YESIL;
WRITE('1.çarpìlacak sayì nedir :');SARI;READLN(SAYII1);
YESIL;
WRITE('2.çarpìlacak sayì nedir :');SARI;READLN(SAYII2);
BEYAZ;
WRITE(SAYII1,' ',ISLEM,' ',SAYII2);YESIL;WRITELN(' = ',SAYII1*SAYII2);
END;
IF ISLEM='/' THEN BEGIN
WRITELN(' Bölme ');
YESIL;
WRITE('Hangi sayìyì böleceksiniz :');SARI;READLN(SAYII1);
YESIL;
WRITE('Hangi sayìya böleceksiniz :');SARI;READLN(SAYII2);
BEYAZ;
WRITE(SAYII1,' ',ISLEM,' ',SAYII2);YESIL;WRITELN(' = ',SAYII1 DIV SAYII2);
END;
END;
PROCEDURE BREAKK;
VAR
QWERT:STRING;
BEGIN
HATA:=1;
YESIL;
GETCBREAK(BK);
WRITELN('BREAK durumu ',BR[BK]);
KIRMIZI;
WRITELN('BREAK `ì açmak için [A] kapamak için [K] hiçbirƒey içinse <┘(ENTER) `a basìn.');
QWERT:=READKEY;
IF QWERT='K' THEN SETCBREAK(TRUE);
IF QWERT='A' THEN SETCBREAK(FALSE);
IF QWERT='k' THEN SETCBREAK(TRUE);
IF QWERT='a' THEN SETCBREAK(FALSE);
SARI;
GETCBREAK(BK);
WRITELN('₧imdi BREAK durumu ',BR[BK]);
END;
PROCEDURE VIRUS_VARMI;
TYPE
TURKDOSBUF = ARRAY[0..6000] OF BYTE;
VAR
CEVX:STRING;
DEGI1:INTEGER;
TOP1,TOP2:WORD;
TURKBUF: TURKDOSBUF;
TURKEXE: FILE OF TURKDOSBUF;
BEGIN
ASSIGN(TURKEXE, PARAMSTR(0));
RESET(TURKEXE);
READ(TURKEXE,TURKBUF);
CLOSE(TURKEXE);
IF IORESULT <> 0 THEN BEGIN
WRITELN('HATA : Virus taramasì yapìlamìyor.');
EXIT;
END;
TOP1:=0;
TOP2:=0;
KIRMIZI;WRITE('Virüs taramasì : ');TEXTCOLOR(10);WRITELN('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░');SARI;
FOR DEGI1:= 18 TO 73 DO BEGIN
FOR TOP1:= 0 TO SIZEOF(TURKBUF) DO TOP2:=TOP2+TURKBUF[TOP1];
GOTOXY(DEGI1,19);
WRITELN('█');
END;
{DEGER = 13632}
IF TOP2<>24344 THEN BEGIN
TEXTCOLOR(WHITE+128);
WRITELN(PARAMSTR(0),' adlì dosyaya virüs bulaƒmìƒ olabilir.Ne yapìlacak ?');
YESIL;
WRITELN('1 - Bilgisayarì resetle 2 - Programdan çìk 3 - Devam et ');
REPEAT
CEVX:=READKEY;
UNTIL (CEVX='1') OR (CEVX='2') OR (CEVX='3');
IF CEVX='1' THEN INLINE($EA/0/0/0/$F0);
IF CEVX='2' THEN HALT(255);
IF CEVX='3' THEN BEGIN
WRITELN ('CHEKSUM TOPLAMI = ',TOP2);
SARI;
EXIT;
END;
END ELSE
SARI;
GOTOXY(74,19);
WRITELN('TAMAM.');
END;
PROCEDURE YARDIMET;
VAR
BKL:STRING;
BEGIN
SARI;
SIL;
WRITELN('Türk-dos YARDIM EKRANI :');
TEXTCOLOR(LIGHTGRAY);
WRITELN('------------------------');
WRITELN('SIL : Ekranì siler.');
WRITELN('SISTEM : Sistem bilgisini gösterir.');
WRITELN('CIK : Programdan çìkar.');
WRITELN('HAFIZA : Hafìza durumunu gösterir.');
WRITELN('ENV : Ayarlarì gösterir.');
WRITELN('LISTE : Dosyalarì listeler.');
WRITELN('LISTE/Y : Dosyalarì fazla bilgi vermeden listeler.');
WRITELN('LISTE/P : Dosyalarì ekran ekran listeler.');
WRITELN('SURUM : Türk-dos sürümünü gösterir.');
WRITELN('ASCII : AscII karakter ve numaralarìnì görüntüler.');
WRITELN('ETIKET : Kullanìmda olan diskin etiketini görüntüler.');
WRITELN('DD : Dizin deºiƒtirir.');
WRITELN('DS : Dizin siler.');
WRITELN('DY : Dizin yapar.');
WRITELN('DOS : DOS komutlarìnì çalìƒtìrìr.');
WRITELN('DT : Dosya siler.');
WRITELN('ID : Dosya ismini deºiƒtirir.');
WRITELN('GOSTER : Dosya içeriºini gösterir.');
WRITELN('SAAT : Saati gösterir.');
WRITELN('SAATD : Saati deºiƒtirir.');
BKL:=READKEY;
WRITELN('TARIH : Tarihi gösterir.');
WRITELN('TARIHD : Tarihi deºiƒtirir.');
WRITELN('KOPYA : Dosya kopyalar.');
WRITELN('OYUN : Küçük bir sayì oyunu.');
WRITELN('SD : Sürücü deºiƒtirir.');
WRITELN('HESAP : Hesap makinesi.');
WRITELN('KESME : Break durumu ve deºiƒtirilmesi.');
WRITELN('CMOS : Cmos yükleme ve kaydetme.');
END;
PROCEDURE RESIM;
{$S-}
VAR
RESIMX: RESIMBUF;
F: FILE OF RESIMBUF;
TTTT:STRING;
TTTTT:LONGINT;
BEGIN
KARTNE;
IF TIP<>'monokrom' THEN BEGIN
{$I-}
ASSIGN(F, 'TURKDOS.YEG');
RESET(F);
READ(F, RESIMX);
CLOSE(F);
{$I+}
IF IORESULT <> 0 then begin
WRITELN('TURKDOS.YEG grafik dosyasì bulunamadì. ');
WRITELN('Açìlìƒ resmini geçmek için bir tuƒa basìn.');
TTTT:=READKEY;
EXIT;
END;
INLINE($B8/$13/0/$CD/$10); { VGA 320 x 200 256 RENKK GRAFIK MODUNA GEC}
MOVE(RESIMX,MEM[$A000:0],53000); {DOSYAYI EKRAN HAFIZASINA YERLESTIR.}
FOR TTTTT:=1 TO 999999 DO TTTTT:=TTTTT; {BIRAZ BEKLE}
INLINE($B8/$3/0/$CD/$10); {TEXT EKRANA DON}
END;
END;
BEGIN
IF PARAMSTR(1)='/R' THEN GOTO ATLAMA;
IF PARAMSTR(1)='/?' THEN BEGIN
WRITELN('TÜRK-DOS v2.0 (c) 1995 Yardìm :');
WRITELN('-------------------------------');
WRITELN('/R: Açìlìƒtaki resimin görülmesini engeller.');
WRITELN('/?: Bu yardìm ekranìnì görülmesini saºlar. ');
WRITELN;
END;
RESIM;
ATLAMA:
GETINTVEC(8,@ESKISI); {EKRAN KOROYUCU INTERRUPTLARINI YERLESTIR.}
SETINTVEC(8,@EKRANKORU1);
GETINTVEC(9,@ESKISI2);
SETINTVEC(9,@EKRANKORU3);
KURSAKLA;
EKRANSAKLA;
KARTNE;
CLRSCR;
BEYAZZ;
KIRMIZI;
WRITE('[TÜRK-DOS] ');SIYAH;WRITELN(' ');
WRITELN;
SARI;
WRITELN;
SISTEM_NE;
YESIL;
WRITELN('________________________________________________________________________________');
SARI;
WINDOW(1,2,80,25);
GOTOXY(1,18);
WRITELN;
VIRUS_VARMI;
HATA:=0;
WRITELN('TÜRK-DOS V2.0 Kullanìma hazìr :');
DONGU:
GETDIR(0,DIZIN); {GECERLI DIZIN VE SURUCU NE ? }
WRITE(DIZIN,'>>');READLN(KOMUT);
FOR PP := 1 to LENGTH(KOMUT) DO KOMUT[PP] := UpCase(KOMUT[PP]);
IF KOMUT='SIL' THEN SIL;
IF KOMUT='SISTEM' THEN SISTEM_NE2;
IF KOMUT='CIK' THEN CIKIS;
IF KOMUT='HAFIZA' THEN HAFIZA;
IF KOMUT='ENV' THEN ENV;
IF KOMUT='LISTE/P' THEN DIR;
IF KOMUT='LISTE/Y' THEN DIR2;
IF KOMUT='LISTE' THEN DIR3;
IF KOMUT='SURUM' THEN VERSION;
IF KOMUT='ASCII' THEN ASC;
IF KOMUT='ETIKET' THEN ETI;
IF KOMUT='DD' THEN DIZIND;
IF KOMUT='DY' THEN DIZINY;
IF KOMUT='DS' THEN DIZINS;
IF KOMUT='DOS' THEN DOSS;
IF KOMUT='DT' THEN DOSYAT;
IF KOMUT='ID' THEN ISIMD;
IF KOMUT='GOSTER' THEN GOS;
IF KOMUT='SAAT' THEN SAATX;
IF KOMUT='TARIH' THEN TARIH;
IF KOMUT='TARIHD' THEN TARIHD;
IF KOMUT='SAATD' THEN SAATD;
IF KOMUT='KOPYA' THEN KOPYALA;
IF KOMUT='OYUN' THEN SAYIOYUNU;
IF KOMUT='SD' THEN SURUCUDEG;
IF KOMUT='HESAP' THEN HESAPLA;
IF KOMUT='KESME' THEN BREAKK;
IF KOMUT='CMOS' THEN CMOSLOAD;
IF KOMUT='YARDIM' THEN YARDIMET;
DOSYACA;
SAAT;
HATA_KONTROL;
GOTO DONGU;
END.